home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Iff / ShowIFF.p < prev   
Encoding:
Text File  |  1997-05-06  |  3.0 KB  |  102 lines
  1. program ShowIFF;
  2.  
  3. {  ------------------------------------------------------------------------
  4.     ShowIFF.p  -  ein kleines Tool zum Anzeigen von Iff-Bildern,
  5.     basierend auf ShowIFF.c von Christian A. Weber .
  6.     Benötigt die iff.library (im LIBS:-Ordner oder im ROM)
  7.     Diese Programm ist PD, kann also ohne weiteres verbreitet und
  8.     verändert werden.
  9.     ( Diese Version erkennt keine Overscan-Pics ... )
  10.    ------------------------------------------------------------------------ }
  11.  
  12. {$I "Include:graphics/gfxbase.i"   }
  13. {$I "Include:intuition/intuition.i"}
  14. {$I "Include:intuition/screens.i"  }
  15. {$I "Include:Utils/stringlib.i"    }
  16. {$I "Include:Utils/Parameters.i"   }
  17. {$I "Include:libraries/iff.i"      }
  18. {$I "Include:exec/libraries.i"     }
  19.  
  20. Const
  21.     ns : NewScreen =  (0,0,0,0,0,0,0,0,CUSTOMSCREEN_f+SCREENQUIET_f,
  22.     NIL, "ShowIFF by Christian A. Weber(C)/B. Künnen(PCQ)", NIL, NIL);
  23.  
  24. Var
  25.     MyIff      : IffFile;
  26.     i,count    : Integer;
  27.     colortable : Array[1..128] of Short;
  28.     bmhd       : BitMapHeaderPtr;
  29.     myscreen   : ScreenPtr;
  30.     GfxBase    : GfxBasePtr;
  31.     arg        : String;
  32.  
  33.  
  34.  
  35. Procedure CleanExit(why : String; rt : Integer);
  36. Begin
  37.     if myscreen<>NIL then CloseScreen(myscreen);
  38.     if MyIff<>NIL  then CloseIFF(MyIff);
  39.  
  40.     If GfxBase<>NIL then CloseLibrary(Address(GfxBase));
  41.     If IffBase<>NIL then CloseLibrary(IffBase);
  42.  
  43.     If why<>NIL then write(why);
  44.     Exit(rt);
  45. End;
  46.  
  47.  
  48. { -- Hauptprogramm -- }
  49.  
  50. BEGIN
  51.     arg:=AllocString(80);
  52.     GetParam(1,arg);    { -- Parameter holen, wenn vorhanden -- }
  53.                 { -- sonst abfragen             -- }
  54.     if strlen(arg)=0 then begin
  55.       Write("Welches Bild möchten sie sehen : ");
  56.       Readln(arg);
  57.       If strlen(arg)=0 then CleanExit("Format: ShowIFF filename\n",10);
  58.     end;
  59.  
  60.     { -- Libraries öffnen -- }
  61.     GfxBase := GfxBasePtr(OpenLibrary("graphics.library",0));
  62.     if GfxBase=NIL then CleanExit("No Gfx.lib\n",25);
  63.  
  64.     IFFBase := OpenLibrary(IFFNAME,18);    { -- hier reicht 18 -- }
  65.     if IFFBase = NIL then
  66.         cleanexit("Copy the iff.library to your LIBS: directory!\n",10);
  67.  
  68.     write("Attempt loading the file ",arg,"\n");
  69.  
  70.     { -- IFF-Pic laden -- }
  71.     MyIff:=OpenIFF(arg);
  72.     if MyIff=NIL then    Cleanexit("Error opening file\n",5);
  73.  
  74.     { -- Bitmap-Header holen -- }
  75.     bmhd := GetBMHD(MyIff);
  76.     if  bmhd = NIL then    CleanExit("BitMapHeader not found\n",5);
  77.  
  78.     ns.Width      := bmhd^.w;        { -- Infos zum Pic -- }
  79.     ns.Height     := bmhd^.h;        { -- holen, für    -- }
  80.     ns.Depth      := bmhd^.nPlanes;        { -- den Screen    -- }
  81.     ns.ViewModes  := GetViewModes(MyIff);
  82.                         { -- Screen öffnen -- }
  83.     myscreen := OpenScreen(Adr(ns));
  84.     if  myscreen = NIL then  CleanExit("Can't open screen!\n",10);
  85.  
  86.                         { -- Farben setzen -- }
  87.     count := GetColorTab(MyIff,Adr(colortable));
  88.     if (count>32) then  count:=32;
  89.     { -- HAM/Halfbrite-Pictures haben 64++ Farben -- }
  90.  
  91.     LoadRGB4(Adr(myscreen^.SViewPort),Adr(colortable),count);
  92.  
  93.     { -- Pic ggf. decodieren und in den Screen kopieren -- }
  94.     if NOT DecodePic(MyIff,Adr(myscreen^.SBitMap)) then
  95.         CleanExit("Can't decode picture\n",10);
  96.  
  97.     Delay(200);  { -- 4 Secs warten; ggf. auf Maus umprogr. -- }
  98.  
  99.     CleanExit(NIL,0);        { -- Prg sauber verlassen -- }
  100. End.
  101.  
  102.